unit WebUpdate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, WebThread, CheckLst, ExtCtrls, IniFiles,
  ShellApi, TypInfo, Buttons;

type
  TWebUpdateForm = class(TForm)
    Label1: TLabel;
    lv: TListView;
    Label2: TLabel;
    lblTotalSize: TLabel;
    memDescr: TMemo;
    Label3: TLabel;
    Label4: TLabel;
    cmbGroups: TComboBox;
    ProgressBar1: TProgressBar;
    Label5: TLabel;
    lblStatus: TLabel;
    Shape1: TShape;
    Bevel1: TBevel;
    Image1: TImage;
    Label6: TLabel;
    cmbMirrors: TComboBox;
    Label7: TLabel;
    Bevel2: TBevel;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    btnCheck: TBitBtn;
    btnClose: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lvClick(Sender: TObject);
    procedure lvChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure cmbGroupsChange(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmbMirrorsChange(Sender: TObject);
  private
    { Private declarations }
    wThread: TWebThread;
    fUpdateList: TList;
    fMirrorList: TStrings;
    fErrorsList: TStrings;
    fSelfUpdate: string;
    procedure GetUpdateInfo(Sender: TObject);
    procedure DownloadFiles(Sender: TObject);
    function CheckFile(Filename: string): boolean;
    procedure ClearList;
    procedure FillList(Filter: string);
    procedure CalcTotalSize;
    procedure UpdateSelf;
    procedure GetMirrorList;
    function ReplaceMacros(Source: string): string;
    procedure WriteInstalled(index : integer);
    procedure EnableForm;
    procedure DisableForm;
  public
    { Public declarations }
    BasePath: string;
    procedure wCheckTerminate(Sender: TObject);
    procedure wDownloadTerminate(Sender: TObject);
    procedure wThreadMessage(Sender: TObject; MsgCode: TWUMessageReason; Msg: string; TransferSize, CurrentSize: cardinal);
  end;

var
  WebUpdateForm: TWebUpdateForm;

implementation

uses utils, version, devcfg;

{$R *.dfm}

const
  MAGIC_HEADER = '{WebUpdate_config_file}';
  CONF_FILE = 'webupdate.conf';
  DEFAULT_MIRROR = 'Andreas Aberg''s server=http://vUpdate.servebeer.com/';  // 'bloodshed.net (Bloodshed server)=http://haiku.bloodshed.net/dev/webupdate/';

var
  BASE_URL: string;
  AllGroupsText: string = '<All groups>';

procedure TWebUpdateForm.wThreadMessage(Sender: TObject; MsgCode: TWUMessageReason; Msg: string; TransferSize, CurrentSize: cardinal);
begin
  case MsgCode of
    wumrRetrieveProgress: begin
        ProgressBar1.Max := TransferSize;
        ProgressBar1.Position := CurrentSize;
      end;
    wumrConnectError,
      wumrRetrieveError,
      wumrUnknownError: fErrorsList.Add(Msg);
  else
    ProgressBar1.Position := 0;
    lblStatus.Caption := Msg;
  end;
end;

procedure TWebUpdateForm.wCheckTerminate(Sender: TObject);
var
  tmp: string;
begin
  if fErrorsList.Count > 0 then
    MessageDlg('Could not connect to remote site. The remote site might be down, or your connection ' +
      'to the Internet might not be working...'#13#10#13#10'Please try another mirror site...', mtError, [mbOk], 0)
  else begin
    if (wThread.LastMessage = wumrDisconnect) and
      FileExists(PUpdateRec(wThread.Files[0])^.TempFilename) then begin
      tmp := PUpdateRec(wThread.Files[0])^.TempFilename;
      if CheckFile(PUpdateRec(wThread.Files[0])^.TempFilename) then begin
        btnCheck.OnClick := DownloadFiles;
        btnCheck.Caption := 'Download selected';
        memDescr.Lines.Clear;
        memDescr.Lines.Add('Step 1: Select the updates you want to download.');
        memDescr.Lines.Add('Step 2: Press "Download selected" to download the selected updates from the server.');
      end;
      DeleteFile(tmp);
    end;
  end;
  FreeAndNil(wThread);
  EnableForm;
end;

procedure TWebUpdateForm.wDownloadTerminate(Sender: TObject);
var
  I: integer;
  Dest, PackFileName: string;
begin
  if fErrorsList.Count = 0 then
    MessageDlg('The updates you selected have been downloaded. Now they will ' +
      'be installed.',
      mtInformation, [mbOk], 0)
  else if fErrorsList.Count > 0 then begin
    Dest := '';
    for I := 0 to fErrorsList.Count - 1 do
      Dest := Dest + fErrorsList[I] + #13#10;
    MessageDlg('The following files were not downloaded due to errors...'#13#10#13#10 + Dest, mtError, [mbOk], 0);
    if fErrorsList.Count < wThread.Files.Count then
      if MessageDlg('Some updates were retrieved though. Do you want to install them?',
        mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
        FreeAndNil(wThread);
        EnableForm;
        Exit;
      end;
  end;
  for I := 0 to wThread.Files.Count - 1 do begin
    if FileExists(PUpdateRec(wThread.Files[I])^.TempFilename) then begin
      if PUpdateRec(wThread.Files[I])^.Execute then begin
        //RenameFile(PUpdateRec(wThread.Files[I])^.TempFilename, ChangeFileExt(PUpdateRec(wThread.Files[I])^.TempFilename, '.DevPak'));
        PackFileName := ExtractFilePath(Application.ExeName) + PACKAGES_DIR + ExtractFileName(PUpdateRec(wThread.Files[I])^.LocalFilename);
        ForceDirectories(ExtractFilePath(Application.ExeName) + PACKAGES_DIR); // Create <devcpp>\Packages
        try
          MoveFile(PChar(PUpdateRec(wThread.Files[I])^.TempFilename), PChar(PackFileName));
        except
          MessageDlg('Could not move file: ' + PUpdateRec(wThread.Files[I])^.TempFilename + ' please verify you have enough permissions to install packages on this system', mtWarning, [mbOK], 0);
        end;
        if FileExists(ExtractFilePath(Application.ExeName) + PACKMAN_PROGRAM) then begin
          ExecuteFile(ExtractFilePath(Application.ExeName) + PACKMAN_PROGRAM, PackFileName, '', SW_SHOW);
          WriteInstalled(I);
        end
        else
          MessageDlg('Could not find PackMan.exe in Dev-C++ folder !', mtError, [mbOK], 0);
      end
      else begin
        Dest := {BasePath + } ReplaceMacros(PUpdateRec(wThread.Files[I])^.InstallPath + '\' + PUpdateRec(wThread.Files[I])^.LocalFilename);
        ForceDirectories(ExtractFilePath(Dest));
        if CopyFile(PChar(PUpdateRec(wThread.Files[I])^.TempFilename), PChar(Dest), False) then begin
          DeleteFile(PUpdateRec(wThread.Files[I])^.TempFilename);
          WriteInstalled(I);
        end
        else begin
          if LowerCase(Dest) = LowerCase(Application.ExeName) then begin
            fSelfUpdate := PUpdateRec(wThread.Files[I])^.TempFilename;
            WriteInstalled(I);
          end
          else
            MessageDlg('Could not install file: ' + Dest, mtError, [mbOK], 0);
        end;
        if LowerCase(PUpdateRec(wThread.Files[I])^.LocalFilename) = LowerCase(DEV_WEBMIRRORS_FILE) then
          GetMirrorList;
      end;
    end;
  end;
 // MessageDlg('The downloaded updates were installed. The WebUpdate window will now close.', mtInformation, [mbOk], 0);
  FreeAndNil(wThread);
  UpdateSelf;
  for i := 0 to fUpdateList.Count - 1 do
    if Assigned(fUpdateList[i]) then
      PUpdateRec(fUpdateList[i])^.Selected := false;
  CalcTotalSize;
  EnableForm;
end;

procedure TWebUpdateForm.WriteInstalled(index : integer);
var i : integer;
begin
  if FileExists(devDirs.Config + 'devcpp.cfg') then
    with TIniFile.Create(devDirs.Config + 'devcpp.cfg') do
      try
        WriteString(WEBUPDATE_SECTION, PUpdateRec(wThread.Files[index])^.Name, PUpdateRec(wThread.Files[index])^.Version);
      finally
        Free;
      end;
  for i := 0 to lv.Items.Count - 1 do
    if lv.Items[i].Data = PUpdateRec(wThread.Files[index]) then begin
      lv.Items.Delete(i);
      break;
    end;
end;

function TWebUpdateForm.CheckFile(Filename: string): boolean;
var
  sl: TStringList;
  I: integer;
  Ini, LocalIni: TIniFile;
  P: PUpdateRec;
begin
  Result := False;

  ClearList;

  if (not FileExists(Filename)) or (not FileExists(devDirs.Config + 'devcpp.cfg')) then
    Exit;

  Ini := TIniFile.Create(Filename);

  LocalIni := TIniFile.Create(devDirs.Config + 'devcpp.cfg');

  sl := TStringList.Create;
  try
    sl.LoadFromFile(Filename);
    Result := (sl.Count > 0) and (sl[0] = MAGIC_HEADER);
    if not Result then
      Exit;
    Ini.ReadSections(sl);
    cmbGroups.Items.Clear;
    cmbGroups.Items.Add(AllGroupsText);
    cmbGroups.ItemIndex := 0;
    for I := 0 to sl.Count - 1 do begin
      P := New(PUpdateRec);
      P^.Name := sl[I];
      P^.Description := Ini.ReadString(sl[I], 'Description', '');
      P^.RemoteFilename := Ini.ReadString(sl[I], 'RemoteFilename', '');
      P^.LocalFilename := Ini.ReadString(sl[I], 'LocalFilename', '');
      P^.Group := Ini.ReadString(sl[I], 'Group', '');
      P^.InstallPath := Ini.ReadString(sl[I], 'InstallPath', '');
      P^.Version := Ini.ReadString(sl[I], 'Version', '<unknown>');
      P^.LocalVersion := GetVersionString(BasePath + P^.InstallPath + P^.LocalFilename);
      P^.Size := Ini.ReadInteger(sl[I], 'Size', 0);
      P^.Date := Ini.ReadString(sl[I], 'Date', '');
      P^.Selected := False;
      P^.Execute := Ini.ReadBool(sl[I], 'Execute', false);
      // verify if the user already has the last update
      if  LocalIni.ReadString(WEBUPDATE_SECTION, P^.Name, '') = P^.Version then begin
        Dispose(P);
        continue;
      end;
      fUpdateList.Add(P);
      if cmbGroups.Items.IndexOf(P^.Group) = -1 then
        cmbGroups.Items.Add(P^.Group);
    end;
  finally
    sl.Free;
    Ini.Free;
    LocalIni.Free;
  end;
  FillList('');
end;

procedure TWebUpdateForm.ClearList;
begin
  while fUpdateList.Count > 0 do begin
    if Assigned(fUpdateList[0]) then
      Dispose(PUpdateRec(fUpdateList[0]));
    fUpdateList.Delete(0);
  end;
end;

procedure TWebUpdateForm.FillList(Filter: string);
var
  I: integer;
begin
  lv.Items.Clear;
  for I := 0 to fUpdateList.Count - 1 do
    if (Filter = '') or (Filter = PUpdateRec(fUpdateList[I])^.Group) then
      with lv.Items.Add do begin
        Data := fUpdateList[I];
        Caption := PUpdateRec(fUpdateList[I])^.Name;
        Checked := PUpdateRec(fUpdateList[I])^.Selected;
        SubItems.Add(PUpdateRec(fUpdateList[I])^.Version);
        SubItems.Add(PUpdateRec(fUpdateList[I])^.LocalVersion);
        if PUpdateRec(fUpdateList[I])^.Size > 1024 then
          SubItems.Add(Format('%d KB', [PUpdateRec(fUpdateList[I])^.Size div 1024]))
        else if PUpdateRec(fUpdateList[I])^.Size > 0 then
          SubItems.Add(Format('%d Bytes', [PUpdateRec(fUpdateList[I])^.Size]))
        else
          SubItems.Add('Unknown');
        SubItems.Add(PUpdateRec(fUpdateList[I])^.Date);
      end;
end;

procedure TWebUpdateForm.FormCreate(Sender: TObject);
begin
  fUpdateList := TList.Create;
  fMirrorList := TStringList.Create;
  fErrorsList := TStringList.Create;
  ProgressBar1.Position := 0;
  lblStatus.Caption := 'Disconnected';
  CalcTotalSize;
  btnCheck.OnClick := GetUpdateInfo;
  fSelfUpdate := '';
  cmbGroups.Items.Add(AllGroupsText);
  cmbGroups.ItemIndex := 0;
  GetMirrorList;
  memDescr.Lines.Add('Press "Check for updates" to request a list of available updates on the server.');
end;

procedure TWebUpdateForm.FormDestroy(Sender: TObject);
begin
  ClearList;
  FreeAndNil(fUpdateList);
  FreeAndNil(fMirrorList);
  FreeAndNil(fErrorsList);
end;

procedure TWebUpdateForm.lvClick(Sender: TObject);
var
  I: integer;
begin
  for I := 0 to lv.Items.Count - 1 do
    if Assigned(lv.Items[I].Data) then
      PUpdateRec(lv.Items[I].Data)^.Selected := lv.Items[I].Checked;
  CalcTotalSize;
end;

procedure TWebUpdateForm.lvChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if Assigned(lv.Selected) and Assigned(lv.Selected.Data) then
    memDescr.Lines.Text := StringReplace(PUpdateRec(lv.Selected.Data)^.Description, '<CR>', #13, [rfReplaceAll])
  else
    memDescr.Lines.Clear;
end;

procedure TWebUpdateForm.cmbGroupsChange(Sender: TObject);
begin
  if cmbGroups.Text = AllGroupsText then
    FillList('')
  else
    FillList(cmbGroups.Text);
end;

procedure TWebUpdateForm.CalcTotalSize;
var
  I: integer;
  Total: cardinal;
  dTotal: double;
  Count: integer;
begin
  Total := 0;
  Count := 0;
  for I := 0 to fUpdateList.Count - 1 do
    if PUpdateRec(fUpdateList[I])^.Selected then begin
      Total := Total + PUpdateRec(fUpdateList[I])^.Size;
      Inc(Count);
    end;

  dTotal := Total / 1.0;
  lblTotalSize.Caption := Format('%d files total, %d KB (%0.0n Bytes)', [Count, Total div 1024, dTotal]);
end;

procedure TWebUpdateForm.DownloadFiles(Sender: TObject);
var
  I, Count: integer;
begin
  if Assigned(wThread) then begin
    MessageDlg('Already downloading!', mtInformation, [mbCancel], 0);
    Exit;
  end;
  Count := 0;
  for I := 0 to fUpdateList.Count - 1 do
    if PUpdateRec(fUpdateList[I])^.Selected then
      Inc(Count);
  if Count = 0 then begin
    MessageDlg('You have not selected anything!', mtError, [mbOk], 0);
    Exit;
  end;
  DisableForm;
  //lv.Enabled := False;

  fErrorsList.Clear;
  wThread := TWebThread.Create(True);
  wThread.OnTerminate := wDownloadTerminate;
  wThread.OnMessage := wThreadMessage;
  wThread.FreeOnTerminate := False;
  wThread.RemoteBase := BASE_URL;
  for I := 0 to fUpdateList.Count - 1 do
    if PUpdateRec(fUpdateList[I])^.Selected then
      wThread.Files.Add(fUpdateList[I]);
  wThread.Resume;
end;

procedure TWebUpdateForm.GetUpdateInfo(Sender: TObject);
var
  P: PUpdateRec;
begin
  if Assigned(wThread) then begin
    MessageDlg('Already checking!', mtInformation, [mbCancel], 0);
    Exit;
  end;

  fUpdateList.Clear;

  P := New(PUpdateRec);
  P^.Name := 'info on available updates';
  P^.RemoteFilename := CONF_FILE;
  fUpdateList.Add(P);

  fErrorsList.Clear;
  wThread := TWebThread.Create(True);
  wThread.OnTerminate := wCheckTerminate;
  wThread.OnMessage := wThreadMessage;
  wThread.FreeOnTerminate := False;
  wThread.RemoteBase := BASE_URL;
  wThread.Files.Add(P);
  wThread.Resume;
end;

procedure TWebUpdateForm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TWebUpdateForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
//  Action := caFree;
end;

procedure TWebUpdateForm.UpdateSelf;
var
  SU: TResourceStream;
//  TempPath: array[0..MAX_PATH + 1] of Char;
  TempFile: string;
  ErrMsg: string;
begin
  if fSelfUpdate = '' then
    Exit;
  try
    CopyFile(PChar(Application.ExeName), PChar(ChangeFileExt(Application.ExeName, '.exe.BACKUP')), False);
  except
    MessageDlg('Could not make a backup of devcpp.exe, please verify from your system administrator that you have enough permissions to update Dev-C++.', mtWarning, [mbOK], 0);
    Exit;
  end;
  CopyFile(PChar(fSelfUpdate), PChar(ChangeFileExt(Application.ExeName, '.Update')), False);
  DeleteFile(fSelfUpdate);
  fSelfUpdate := ChangeFileExt(Application.ExeName, '.Update');
  ErrMsg := 'Update failed...'#10 +
    'Please update "' + ExtractFileName(Application.ExeName) + '" manually:'#10#10 +
    'Copy "' + fSelfUpdate + '" to "' + Application.ExeName + '"';
  SU := TResourceStream.Create(HInstance, 'SELFUPDATER', 'EXE');
  try
  //  GetTempPath(MAX_PATH + 1, TempPath); // was causing a BSOD under some systems...
    TempFile := 'updater.exe';
    SU.SaveToFile(TempFile);
    Application.ProcessMessages;
    ShellExecute(0,
      'open',
      PChar(TempFile),
      PChar(fSelfUpdate + ' ' + Application.ExeName + ' "Self Updating" "Self-updated succesfully!" "' + ErrMsg + '"'),
      nil,
      SW_HIDE);
  finally
    SU.Free;
  end;
end;

procedure TWebUpdateForm.GetMirrorList;
var
  ini: TIniFile;
  I: integer;
begin
  ini := TIniFile.Create(devDirs.Config + DEV_WEBMIRRORS_FILE);
  try
    ini.ReadSectionValues('WebUpdate mirrors', fMirrorList);
  finally
    ini.Free;
  end;

  // add default mirror if list is empty
  if fMirrorList.Count = 0 then
    fMirrorList.Add(DEFAULT_MIRROR);

  cmbMirrors.Items.Clear;

  // make sure that all URLs end with a slash
  for I := 0 to fMirrorList.Count - 1 do begin
    if (fMirrorList[I] <> '') and (fMirrorList[I][Length(fMirrorList[I])] <> '/') then
      fMirrorList[I] := fMirrorList[I] + '/';
    cmbMirrors.Items.Add(fMirrorList.Names[I]);
  end;

  if cmbMirrors.Items.Count > 0 then
    cmbMirrors.ItemIndex := 0;
  BASE_URL := fMirrorList.Values[cmbMirrors.Text];
end;

procedure TWebUpdateForm.cmbMirrorsChange(Sender: TObject);
begin
  BASE_URL := fMirrorList.Values[cmbMirrors.Text];
end;

function TWebUpdateForm.ReplaceMacros(Source: string): string;
var
  idx1, idx2: integer;
  PropName: string;
  PropValue: string;
begin
  Result := Source;
  repeat
    idx1 := Pos('{', Result) + 1;
    idx2 := Pos('}', Result) - 1;
    if (idx1 > 0) and (idx2 > idx1) then begin
      PropName := Copy(Result, idx1, idx2 - idx1 + 1);
      if IsPublishedProp(TdevDirs(devDirs), PropName) then
        PropValue := GetStrProp(TdevDirs(devDirs), PropName)
      else if PropName = 'OriginalPath' then
        PropValue := ExtractFilePath(Application.ExeName)
      else
        Break;
      Result := StringReplace(Result, '{' + PropName + '}', PropValue, [rfReplaceAll]);
    end
    else
      Break;
  until False;
  Result := StringReplace(Result, '\\', '\', [rfReplaceAll]);
end;

procedure TWebUpdateForm.EnableForm;
begin
  cmbMirrors.Enabled := true;
  cmbGroups.Enabled := true;
  lv.Enabled := true;
  btnCheck.Enabled := true;
end;

procedure TWebUpdateForm.DisableForm;
begin
  cmbMirrors.Enabled := false;
  cmbGroups.Enabled := false;
  lv.Enabled := false;
  btnCheck.Enabled := false;
end;


end.

